#!/usr/bin/env perl
###############################################################################
#
# Creates a table that shows the site mean and standard deviation of each subtype
# and supertype  (To be completed by Daniel)
# Developed by Rafael Garabato [rafael.garabato@fudepan.org.ar]
#
###############################################################################
#
#   Copyright (C) Rafael Garabato, 2008-2009, FuDePAN
#
#   table_gen is part of hla-hiv-analyzer.
#
#   hla-hiv-analyzer is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 3 of the License, or
#   (at your option) any later version.
#
#   hla-hiv-analyzer is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with hla-hiv-analyzer.  If not, see <http://www.gnu.org/licenses/>.
#
###############################################################################

use strict;
use warnings;
require 5;

# Needed Modules
use lib './modules';
use Getopt::Long;
use File::Temp qw/ :mktemp  /;
use XML::Simple;


# unbuffer the outputs
select STDERR; $| = 1;
select STDOUT; $| = 1;


# some definitions
use constant ZFALSE => 0;
use constant ZTRUE => 1;

# working variables
my %options;
my $subtypeFile;  
my $geneString;
my $helpMode;
my $callerScriptName;
my %sequenceIDTable; # Hash with the sequence Ids that belong to each subtype
my %sequenceHash; #relates a sequenceId with a sequence
my @superTypesList;
my %seqVsValueTable;
my %subTypeVsValueTable;
my $tmpFastaFileName = "fastafile";
my $separateTables;#Separates the data in two tables one for mean and one for std dev.
my $ofile = "";
my $seqtablefile = "";

our $verbose;
our $logpattern;
our $logfile;
our $log_filehandle;
our $noPedantic;
our $pedanticModeMsg;
our $verboseparam="";
our $randomizeSeq;
our $keepFasta;
our $xmlFileName;

#Grabbing out the caller script name 
$callerScriptName = $0;

#Parsing out the provided arguments
#Check that enough arguments were provided
if ( @ARGV > 0 )
{
	#Display help if one of the needed arguments are missing
	GetOptions(
	    'subtypesfile=s'     => \$subtypeFile,
	    'outputxml=s'     => \$xmlFileName,
	    'feature=s'     => \$geneString,
	    'ofile:s'     => \$ofile,
   	    'seqtablefile:s'     => \$seqtablefile,
	    'verbose' => \$verbose,
        'nopedantic' => \$noPedantic,
	    'separatetables' => \$separateTables, 
		'logpattern:s' => \$logpattern,
        'randomizeseq:i' => \$randomizeSeq,
        'keepfasta' => \$keepFasta,
	    'help|?' => \$helpMode,
	    ) or usage($callerScriptName, "Invalid Arguments were provided");
}
else
{
	usage($callerScriptName, "No arguments were provided");
}

#Help menu was called
if( defined ($helpMode))
{
	usage($callerScriptName); 
}

if( defined ($randomizeSeq))
{   
    if ($randomizeSeq <1)
    {
	usage($callerScriptName); 
    }
}

#Default variable values
$logfile = $logpattern ."_general.log";

#Opening logfile if was required by user
if ( defined($logpattern) )
{
	 open ( LOGFILE , "+> $logfile" );
	 #storing filehandle into a global variable (nasty?)
	 $log_filehandle = *LOGFILE;
}
#if logfile was not required point all logs to /dev/null
else
{
	$logfile = "/dev/null";	
}


if (defined ($noPedantic))
{
    $pedanticModeMsg="Warning";    
}
else
{
    $pedanticModeMsg="Error";
}

if (defined ($verbose))
{
    #append -v to al commands
    #Not available
    $verboseparam = "--verbose";
}



unless (getSeqIdTable(\%sequenceIDTable,$subtypeFile,$randomizeSeq))
{
    die;
}

unless (getSequenceHash(\%sequenceHash,\%sequenceIDTable,$randomizeSeq))
{
    die "No sequence could be fetched\n";
}

unless (createFastaFile(\$tmpFastaFileName,\%sequenceHash,\%sequenceIDTable))
{
    die "Could not create fasta file\n";
}

unless (getSuperTypes(\@superTypesList))
{
    if (!defined $keepFasta)
    {
        fudepan_print("Removing temporal fasta file $tmpFastaFileName\n");
        unlink($tmpFastaFileName);
    }
    die "Could not obtain the Sypertypes list\n";
}



my @seqIdList = keys %sequenceHash;

unless (getSeqResultTable (\%seqVsValueTable,$tmpFastaFileName,\@superTypesList,\@seqIdList,\%sequenceIDTable))
{
    if (!defined $keepFasta)
    {
        fudepan_print("Removing temporal fasta file $tmpFastaFileName\n");
        unlink($tmpFastaFileName);
    }
    die "Could not get results from netctl page\n";
}


if (defined ($verbose))
{
    #fudepan_print("Sequence vs supertype table\n");
    #my $ofd=*STDOUT;
    #printSeqResultTable($ofd,\%seqVsValueTable, \@superTypesList, \%sequenceIDTable);

}


if (defined ($seqtablefile) && $seqtablefile ne "" )
{
    my $seqfd;
    open $seqfd, ">$seqtablefile" or die "could not open file";
    print $seqfd "Sequence vs supertype table\n";
    printSeqResultTable($seqfd,\%seqVsValueTable, \@superTypesList, \%sequenceIDTable);
    close $seqfd;
}


calcSubTypeVsValueTable(\%subTypeVsValueTable,\%seqVsValueTable,\%sequenceIDTable,\@superTypesList);

my $ofd;
if (defined($ofile) && $ofile ne "")
{
    
    open $ofd, ">$ofile" or die "could not open file";
    printGroupResultTable($ofd,\%subTypeVsValueTable, \@superTypesList, \%sequenceIDTable,$separateTables);
    close $ofd;
}


$ofd=*STDOUT;
printGroupResultTable($ofd,\%subTypeVsValueTable, \@superTypesList, \%sequenceIDTable,$separateTables);

if (defined ($xmlFileName))
{
    if (createXML_file($xmlFileName,\%seqVsValueTable, \@superTypesList, \%sequenceIDTable))
    {
        print "XML file $xmlFileName generated\n";
    }
}

fudepan_print("Success! data was obtained successfully\n");

if (!defined $keepFasta)
{
    fudepan_print("Removing temporal fasta file $tmpFastaFileName\n");
    unlink($tmpFastaFileName);
}

if ( $logfile ne "/dev/null" )
{
	close LOGFILE;
}




#####################################################################
# Functions
#####################################################################

#######
# Helper function to convert a single digit number into a n digit number
# filling with 0 before the number. (turns 1 into 001)
# Parameter: number to convert, precission
# Returns: new number	
#
sub dec_prec 
{
 	my ($num,$prec) = @_;
	my $ret;
	if (defined $num && defined $prec)
	{
		$ret = sprintf("%0${prec}d",$num);
	}
	return $ret;
}

#######
# Wrapper print to stdout
# Parameter: input to print
# Returns: nothing	
#
sub fudepan_print
{
    my $string = shift;

	if ( defined($verbose) )
	{
		# flush all output immediately
		$| = 1;	
		#printing to stderr
		print STDERR "[+] $string";

		#printing also to logfile if it was required by the user
		if ( $logfile ne "/dev/null" )
		{
			print $log_filehandle "[+] $string"; 
		}
	}
}


#######
# Print usage information
# Parameter: script name
# Returns: nothing
#
sub usage 
{
    my ($caller, $stringToDisplay) = @_;

	if ( defined ($stringToDisplay) )
	{
		fudepan_print("Problem detected: $stringToDisplay\n");	
	} 

	#printing help
	die << "EOF";
Secuence fetcher script
Developed by Rafael Garabato [rafael.garabato at fudepan.org.ar]
Usage: $caller [options] (please use quotes for "long inputs")
Required options:   --subtypesfile	name of the file that lists all the sequences per groups
                    --feature		Gene to look for inside the sequence (e.g aagg)
                                        
Optional options: --separatetables  Creates two different tables for mean and std dev.
                  --ofile           Writes the tables to a output file
                  --outputxml <xml_file_name>   Writes the full table without processing in xml format
                  --seqtablefile    Writes the table of sequences vs supertypes in a file
                  --nopedantic      Turns off pedantic mode. If fetching a supertype or a sequence fails, the calculations will proceed ignoring that data.
                  --logpatter       Log pattern to use for logfiles (if not provided all logs will be pointed to \/dev\/null)
                  --randomizeseq n  Randomizes the sequences that are output of sfetcher n times
                  --keepfasta       Keeps the temporal fasta file after the program finishes.
                  --verbose         Verbose output
       	          --help            Help Menu
EOF
}

sub temp_print 
{
    my ($table) = @_;
    print "----------------debug---------------\n";
    foreach my $i (keys %$table)
    {

        my $array = $$table{$i};
        print "-----$i------\n";
        print @$array;
        print "-------------\n";
    }
    
    print "----------------end-debug---------------\n";
}

#######
# Obtains a hash with a list of sequence Ids per group
# Parameter: output hash, file name with the list of sequence Ids
# Returns: status
#
sub getSeqIdTable
{
    my ($table,$fileName,$randomizeSeq) = @_;
    my $status = ZFALSE;
    my @fileContents;
    my $lineNumber=1;

    if ( defined ($table) && defined ($fileName))
    {
        fudepan_print("Getting sequence ID table from file $fileName\n");
        open FILE, $fileName or die $!;
        my @fileContents = <FILE>;
        chomp(@fileContents);
        $status = ZTRUE;
        foreach my $line (@fileContents)
        {
            my $subType;
            my @sequenceIdList;

            my $success = getSubTypeElem (\$subType, \@sequenceIdList, $line);
            if ($success == ZTRUE)
            {
                fudepan_print("Got subtype $subType with sequences @sequenceIdList\n");   
                if (defined($randomizeSeq))
                {     
                    my @randomizedSeq;           
                    fudepan_print("Adding x $randomizeSeq more sequences to the group\n");   
                    @randomizedSeq = randomize_seqlist(\@sequenceIdList,$randomizeSeq);
                    fudepan_print("Got subtype $subType with random sequences @randomizedSeq\n");
                    @sequenceIdList = @randomizedSeq;
                }
                $table->{$subType} = \@sequenceIdList;
                $lineNumber++;
            }
            else
            {
                fudepan_print("Error parsing file $fileName, line $lineNumber\n");
                $status = ZFALSE;
            }
        }

    }
 
    return $status;
}

sub randomize_seqlist
{
    my ($sequenceIdList,$randomizeSeq) = @_;
    my @randomizedSeq;
    foreach my $seq (@$sequenceIdList)
    {
        for (my $i=1; $i <= $randomizeSeq; $i++)
        {
	    my $num = dec_prec($i, length($randomizeSeq));
            push (@randomizedSeq, "$seq-$num");
        }
    }
    return @randomizedSeq;
}

#######
# Parses a line in the subtype file
# Parameter: output subtype, sequence Id vector, line of the file
# Returns: status
#
sub getSubTypeElem
{
    my ($subType,$sequenceIdList,$fileLine) = @_;
    my $status = ZFALSE;

    if ($fileLine =~ /^\s*(.*)\s*:\s*(.*)/)
    {
        $$subType = $1;
        @$sequenceIdList = split(/ /, $2);
        $status = ZTRUE;
    }
    return $status;
}

#######
# Fetchs for a sequence using the sfetcher script
# Parameter: output subtype, sequence Id vector, line of the file
# Returns: status
#
sub getSequence
{
    my ($sequence, $sequenceId, $feature,$retries) = @_;
    my $status = ZFALSE;
	my $localLogFile;
    
    if (! defined ($retries))
    {
        $retries = 1;
    }

    if (defined( $logpattern) )
    {
            $localLogFile = $logpattern."_sfetcher.log";
    }
    else
    {
            $localLogFile = "/dev/null";
    }
    
    
    
    system("echo -e \"\nGetting translation for $sequenceId\" >> $localLogFile");
    my $cmd = "sfetcher.pl --maxretries $retries -s $sequenceId --feature $feature --cachemode -T $verboseparam 2>> $localLogFile";
            
    fudepan_print("$cmd\n");
    $$sequence = `$cmd`;
            
    if ($? == 0)
    {
            chomp ($$sequence);
            fudepan_print("$$sequence\n");        
            $status = ZTRUE;
    }

    return $status;
}

#######
# Obtains a hash that relates the sequence IDs with their sequences
# Parameter: Output hash, input hash with the subtypes as keys and arrays of sequences as data
# Returns: failure or success	
#
sub getSequenceHash
{
    my ($sequenceHash,$sequenceIDTable,$randomizeSeq) = @_; 
    my $status;

    my $get_sequence_retry = 30;


    if (defined ($noPedantic))
    {
        $status=ZFALSE;
    }
    else
    {
        $status=ZTRUE;
    }

    foreach my $subType (keys %$sequenceIDTable)
    {
        my $sequenceIdList = $$sequenceIDTable{$subType};

        foreach my $sequenceId (@$sequenceIdList)
        {
            my $sequence="";
            my $Id="";
            if(!defined($randomizeSeq) || (defined($randomizeSeq) && $sequenceId =~ /(.*)-0*1$/))
            {
                if ($sequenceId =~ /(.*)-0*1$/)
                {
                    $Id = $1;
                }
                else
                {
                    $Id = $sequenceId;
                }
                unless (getSequence(\$sequence, $Id, $geneString,$get_sequence_retry))
                {
                    fudepan_print("$pedanticModeMsg: no sequence for $Id\n");
                    if (!defined ($noPedantic))
                    {
                        #If at least one supertype fails this function will fail in pedantic mode 
                        $status=ZFALSE;
                    }
                }
                else
                {   
                    my $randInd = 1;
                    do
                    {
                        if (defined ($noPedantic))
                        {
                            #If at least one supertype succeeds this function will succeed in pedantic mode
                            $status=ZTRUE;
                        }
                        if (defined ($randomizeSeq))
                        {                
                            my $randomSeq = randomizeSequence($sequence);
                            my $num = dec_prec($randInd, length($randomizeSeq));
				
			    my $key = "$Id-$num";
                            $sequenceHash->{$key}= $randomSeq;
                            fudepan_print("ID $key Randomized sequence:  $randomSeq\n");
                        }
                        else
                        {
                            $sequenceHash->{$Id}=$sequence;
                        }
                        $randInd++;
                    }while (defined($randomizeSeq) && ($randInd <= $randomizeSeq));
                }
            }       
        }    

    }

    return $status;
      
}

#######
# Creates a fasta file with the list of sequences
# Parameter: Name of the output file, sequence Id hash
# Returns: failure or success	
#
sub createFastaFile
{
    my ($fasta_filename,$sequenceHash,$sequenceIDTable) = @_; 
    my $status = ZFALSE;

    
    
    my ($fh, $file) = mkstemp( "$${fasta_filename}_XXXXXX" ) or die "Could not create fastafile: $!\n";
    
    fudepan_print("Creating fasta file $file\n");

    foreach my $group (sort keys %{$sequenceIDTable})
    {
	foreach my $sequenceID ( sort @{$sequenceIDTable->{$group}})
	{
		if (exists $sequenceHash->{$sequenceID})
		{
            
			print $fh ">$sequenceID\n";
			print $fh "$sequenceHash->{$sequenceID}\n";
	
		}
	}
    }
    $status = ZTRUE;
    $$fasta_filename = $file;
    close $fh;

    return $status

}

#######
# Obtains the list of supertypes
# Parameter: output array
# Returns: failure or success	
#
sub getSuperTypes
{
    my ($superTypesList) = @_;
    my $status = ZFALSE;


    my $cmd = "./netctlc.pl -g -l $verboseparam 2>> /dev/null";
    fudepan_print("$cmd\n");    

    my @supertypes = `$cmd`;
    
    fudepan_print("@supertypes");

    if ($? == 0)
    {
        chomp(@supertypes);
        @$superTypesList = @supertypes;        
        $status = ZTRUE;
    }

    return $status;     
}

#####
# Requests user acknoledgement to retry
# Parameter: output hash, fasta file with the list of sequences, Supertype to process, 
# Returns: if should retry or not
#
sub will_retry
{
  my ($tool_name) = @_;
  my $user_answer;
  my $invalid_choice;
  my $retry;

  do
  {
    print "$tool_name failed. Do you want to retry (y/n)\n";
    $user_answer = <STDIN>;
    chomp($user_answer);
    if ($user_answer eq "y")
    {
      	$retry = 1;
	$invalid_choice = 0;
    }
    elsif ($user_answer eq "n")
    {
	$retry = 0;
	$invalid_choice = 0;
    }
    else
    {
	$invalid_choice = 1;
    }
    
  } while ($invalid_choice != 0);

  return $retry;

 }

#######
# Iterates over the sequences for a supertype obtains the site number for earch of them
# Parameter: output hash, fasta file with the list of sequences, Supertype to process, 
# hash with all the sequences in the fasta file
# Returns: failure or success	
#
sub getResults 
{
    my ($seqVsValueTable,$tmpFastaFileName,$superType,$sequenceIdList,$sequenceIDTable)=@_;
    my $status = ZFALSE;
    my @netctrlResult;
    my $retry;
    my $netctrl_status;

    my @results;
	my $localLogFile;
	my $cmd;

	if (defined( $logpattern) )
	{
		$localLogFile = $logpattern."_netctl.log";
	}
	else
	{
		$localLogFile = "/dev/null";
	}
 
    system("echo -e \"\nCalculating new set of epitopes\" >> $localLogFile");
    $cmd = "./netctlc.pl -l -f $tmpFastaFileName -s \"$superType\" $verboseparam 2>> $localLogFile";

    do
    {
      
      
      fudepan_print("$cmd\n");
      @netctrlResult = `$cmd`;

      $netctrl_status = $?;

      if ($netctrl_status != 0 )
      {
	$retry = will_retry("netctrl");
      }
      else
      {
	$retry = 0;
      }
    
    }while ($retry != 0);



    if ($netctrl_status == 0)
    {
        my $numberOfResults;
        my $numberOfSeqId;
        
        fudepan_print("@netctrlResult");
        chomp(@netctrlResult);
        
        @results = @netctrlResult;
        $numberOfResults = @results;
        $numberOfSeqId = @$sequenceIdList;
        fudepan_print("Sent $numberOfSeqId sequences in fasta file, received $numberOfResults results\n");

        if ($numberOfResults == $numberOfSeqId)
        {
            my $index = 0;

            foreach my $group (sort keys %{$sequenceIDTable})
            {
                foreach my $sequenceID ( sort @{$sequenceIDTable->{$group}})
                {
                    my $pos_array;
		    @{$pos_array} = split(/;/,$results[$index]);
                    $seqVsValueTable{$sequenceID}->{$superType} = $pos_array;
                    $index++;
                
                }
            }

            $status = ZTRUE;
        }
    
    }
    return $status;
}

#######
# Gets the table with the sites of all sub types for all the super types
# Parameter: output hash, fasta file with the list of sequences, array of Supertypes to process, 
# hash with all the sequences in the fasta file
# Returns: failure or success	
#
sub getSeqResultTable 
{
    my ($seqVsValueTable,$tmpFastaFileName,$superTypeList,$sequenceIdList,$sequenceIDTable)=@_;
    my $status;

    if (defined ($noPedantic))
    {
        $status=ZFALSE;
    }
    else
    {
        $status=ZTRUE;
    }
    
    foreach my $superType (@$superTypeList)
    {
        my $resultStatus = getResults ($seqVsValueTable,$tmpFastaFileName,$superType,\@seqIdList,$sequenceIDTable);
        if ($resultStatus == ZFALSE)
        {
            fudepan_print("$pedanticModeMsg: Could not get sites for supertype $superType, ignoring supertype\n");
            if (!defined ($noPedantic))
            {
                #If at least one supertype fails this function will fail in pedantic mode            
                $status = ZFALSE;
            }
        }    
        else
        {   
            
            if (defined ($noPedantic))
            {
                #If at least one supertype succeeds this function will succeed in no pedantic mode            
                $status = ZTRUE;
            }
        }
    }
    return $status;
}

#######
# Calculates a table with the mean and std variation for each sub type vs super type.
# Parameter: output hash, sequence hash, Hash with sequences for sub types, 
# array with supertypes
# Returns: failure or success	
#
sub calcSubTypeVsValueTable
{
    my ($subTypeVsValueTable,$seqVsValueTable,$sequenceIDTable,$superTypeList) = @_;

    foreach my $subtype (keys %$sequenceIDTable)
    {
        
        foreach my $superType (@$superTypeList)
        {
            #calulate average
            my $numberOfSeq = 0;
            my $arrayRef = $sequenceIDTable{$subtype};
            my $sum = 0;
            my $mean = 0;
            my $stdDeviation = 0;

            fudepan_print("Calculating data for sub type $subtype, super type $superType\n");

            foreach my $sequence (@$arrayRef)
            {

                if (defined ($seqVsValueTable{$sequence}) && defined($seqVsValueTable{$sequence}->{$superType})) 
                {

                    my $count_order = @{$seqVsValueTable{$sequence}->{$superType}};
		    fudepan_print("Adding $sequence: $count_order\n");
		    $sum += $count_order;
                    $numberOfSeq++;                
                }
            }
            if ($numberOfSeq != 0)
            {
                my $stdsum = 0;
                $mean = $sum / $numberOfSeq;
                fudepan_print("$sum / $numberOfSeq\n");
                #calculate std deviation

                if ($numberOfSeq > 1)
                {
                    foreach my $sequence (@$arrayRef)
                    {
                        
                        if (defined ($seqVsValueTable{$sequence}) && defined($seqVsValueTable{$sequence}->{$superType})) 
                        {
                            my $value =  @{$seqVsValueTable{$sequence}->{$superType}} ;                        
                            $stdsum += ($value-$mean)*($value-$mean);
                                              
                        }
                    }
                    
                    $stdDeviation = sqrt($stdsum / ($numberOfSeq-1));
                }
                else
                {
                    $stdDeviation = 0;                    
                }
                fudepan_print("Subtype $subtype, supertype $superType: $mean +/- $stdDeviation\n");
                my @tuple = ($mean, $stdDeviation);
                $subTypeVsValueTable{$subtype}->{$superType}=\@tuple;
            }
        }
    }
    return ZTRUE;
}

#######
# Prints a bi dimensional hash table
# Parameter: input hash table, Array with row names, array with coloumn names, 
# Name of the first coloumn
# Returns: failure or success	
#

sub printTable
{
    my ($where,$table, $rowNames,  $columnNames,$firstColumnName) = @_;
    my $invalidValue = "NaN"; #Control how numbers that are not in the table will be displayed
    #print column names
   
    print $where "$firstColumnName";

    foreach my $columnName (@$columnNames)
    {
        print $where ", $columnName";
    }
    
    print $where "\n"; #next column

    
    foreach my $row (@$rowNames)
    {
        print  $where "$row";
        
        if (defined ($$table{$row}))
        {
             
            foreach my $col (@$columnNames)
            {
                if ($col eq "")
                {
                    #Print nothing
                }                
                elsif (defined ($$table{$row}->{$col}))
                {
		    
                    print $where ", $$table{$row}->{$col}";
                }
                else
                {
                    print  $where "$invalidValue,";
                }
            }
        }
        else
        {
            foreach my $col (@$columnNames)
            {
                print $where "$invalidValue,";
            }
        }
        print $where "\n";
    }
}

#######
# Prints the sequence vs supertypes table
# Parameter: input hash table, Array with supertypes, hash with groups vs sequences 
# Returns: failure or success	
#

sub printSeqResultTable
{
    my ($where,$seqVsValueTable, $superTypesList, $sequenceIDTable) = @_;
    my @rows = ();


    if (!defined ($where))
    {
        $where = *STDOUT;
    }



    print $where "Sequence IDs vs Supertypes Table\n";
    fudepan_print("Sequence ID list: @rows\n");

    foreach my $group ( keys %$sequenceIDTable)
    {
        my $arrayRef = $sequenceIDTable{$group};
        @rows = @$arrayRef; 
        print $where "Group $group\n";
        printTable($where,$seqVsValueTable, \@rows,\@$superTypesList,"Sequence ID");         

    }



    

}


#######
# Prints the groups vs supertypes table
# Parameter: input hash table, Array with supertypes, hash with groups vs sequences 
# Returns: failure or success	
#

sub printGroupResultTable
{
    my ($where,$groupVsValueTable, $superTypesList, $sequenceIDTable, $separateTables) = @_;

    my @rows = keys %$sequenceIDTable;


    if (!defined ($where))
    {
        $where = *STDOUT;
    }
    
    if (!defined ($separateTables))
    {
        my %Table;
        foreach my $row (keys %$groupVsValueTable)
        {
            my $hashref = $$groupVsValueTable{$row};
            foreach my $col (keys %$hashref)
            {
                
                my $tuple = $$hashref{$col};
                $Table{$row}->{$col} = "$$tuple[0],$$tuple[1]";
                
            }
        }
        my @cols;
    
        foreach my $supertype (@$superTypesList)
        {
            push (@cols,$supertype,"");
        }

        print $where "Groups vs Supertypes Table\n";
        printTable($where,\%Table, \@rows,\@cols,"Group");    

    }
    else
    {
       my %stdDevTable;
       my %meanDevTable;
       foreach my $row (keys %$groupVsValueTable)
        {
            my $hashref = $$groupVsValueTable{$row};
            foreach my $col (keys %$hashref)
            {
                
                my $reftuple = $$hashref{$col};
                my @tuple = @$reftuple;
                $stdDevTable{$row}->{$col} = $tuple[1];
                $meanDevTable{$row}->{$col} = $tuple[0];
            }
        }
        print $where "Mean Groups vs Supertypes Table\n";
        printTable($where,\%meanDevTable, \@rows,\@$superTypesList,"Group");    

        print $where "Std Dev Groups vs Supertypes Table\n";
        printTable($where,\%stdDevTable, \@rows,\@$superTypesList,"Group");    
      
    }
 
    
    

}

#######
# Randomize the elements of a sequence
# Parameter: sequence string
# Returns: randomized sequence
#

sub randomizeSequence
{
    my ($sequence) = @_;
    my $seqLength = length($sequence);
    my $randRange =  $seqLength - 1;
    my $randElem;
    my $randSeq = "";


    my @sequenceArray =split(//, $sequence);

    for (my $i=0; $i < $seqLength; $i++)
    {
        my $range = $randRange-$i;
        $randElem = int(rand($range));
        $randSeq .= $sequenceArray[$randElem];
        splice (@sequenceArray,$randElem,1);
    }
 
    return ($randSeq);

}


#######
# Creates the xml file for the groups, types and sequences
# Parameter: sequence string
# Returns: randomized sequence
#

sub createXML_file
{
    my ($xmlFileName, $seqVsValueTable, $superTypesList, $sequenceIDTable) = @_;

    my $result;
    my $hashRoot = "hla_calculus";
    my $group_tag = "group";
    my $supertype_tag = "haplotype";
    my $sequence_tag = "sequence";
    my $value_tag = "value";
    my $pos_tag = "pos";
    my $pep_tag = "pep";

    my $open_result = open (FILE, ">$xmlFileName"); 

    if ($open_result)
    {    
        print FILE "<$hashRoot>\n";

        foreach my $group ( keys %$sequenceIDTable)
        {
            my $arrayRef = $sequenceIDTable{$group};
            my @groupSequenceIDs = @$arrayRef; 

            print FILE "\t<$group_tag id=\"$group\">\n";

            foreach my $superType (@$superTypesList)
            {
                print FILE "\t\t<$supertype_tag id=\"$superType\">\n";
                foreach my $sequence (@groupSequenceIDs)
                {            
                    my $value = $seqVsValueTable{$sequence}->{$superType};                                
                    print FILE "\t\t\t<$sequence_tag id=\"$sequence\">\n";

                    foreach my $pos ( @{$seqVsValueTable{$sequence}->{$superType}} )
                    {
                        if ($pos =~ /\((.*),(.*)\)/)
                        {                        
                            print FILE "\t\t\t\t<$value_tag $pos_tag=\"$1\" $pep_tag=\"$2\"\/>\n";
                        }
                        else
                        {   
                            die "Unknown error printing XML, check netctl output\n";
                        }
                    }
                    print FILE "\t\t\t<\/$sequence_tag>\n";
                }
                print FILE "\t\t<\/$supertype_tag>\n";        
            }
            print FILE "\t<\/$group_tag>\n";        

        }	

        print FILE "<\/$hashRoot>\n";
        close (FILE);
        $result = ZTRUE;
    }
    else
    {
        print "Could not open output xml file $xmlFileName: $!\n";
        $result = ZFALSE;
    }
    
    return $result;
}


